home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / HTML and CSS Modes / htmlElems.tcl < prev    next >
Encoding:
Text File  |  1999-04-24  |  40.8 KB  |  1,409 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlElems.tcl"
  6.  #                                    created: 96-04-29 21.31.14 
  7.  #                                last update: 99-04-24 13.18.54 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jlinde@telia.com>
  10.  #     www: <http://www.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.1.4
  13.  # 
  14.  # Copyright 1996-1999 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlElems.tcl {} {}
  25.  
  26. #
  27. # <P>
  28. #
  29.  
  30. proc htmlElemParagraph {{attr ""}} {
  31.     global HTMLmodeVars
  32.     if {$HTMLmodeVars(pIsContainer)} { 
  33.         htmlTag "htmlBuildCR2Elem P $attr"
  34.     } else {
  35.         htmlTag "htmlBuildOpening P 1 1 $attr"
  36.     }
  37. }
  38.  
  39.  
  40. # Insert a <BR> in the end of every line in selection.
  41.  
  42. proc htmlInsertLineBreaks {} {
  43.     if {![isSelection]} {
  44.         beep
  45.         message "No selection."
  46.         return
  47.     }
  48.     
  49.     regsub -all "\r" [getSelect] "[htmlSetCase <BR>]\r" text
  50.     replaceText [getPos] [selEnd] $text
  51. }
  52.  
  53. # Remove all <BR> in selection.
  54. proc htmlRemoveLineBreaks {} {
  55.     if {![isSelection]} {
  56.         beep
  57.         message "No selection."
  58.         return
  59.     }
  60.     
  61.     regsub -all -nocase "<BR(\[ \t\r\]+\[^<>\]*>|>)" [getSelect] "" text
  62.     if {$text != [getSelect]} {
  63.         replaceText [getPos] [selEnd] $text
  64.     }
  65. }
  66.  
  67. # Insert <P> at empty lines in selection, and in the beginning of the selection.
  68. # Several empty lines are contracted to one.
  69. proc htmlInsertParagraphs {} {
  70.     global HTMLmodeVars
  71.     if {![isSelection]} {
  72.         beep
  73.         message "No selection."
  74.         return
  75.     }
  76.     set pIsContainer $HTMLmodeVars(pIsContainer)
  77.     
  78.     if {[set oelem [htmlOpenElem P "" 0]] == ""} {return}
  79.     set pind [set indent [htmlFindNextIndent]]
  80.     if {$HTMLmodeVars(indentP)} {set pind [htmlIncreaseIndent $pind]}
  81.     set text "$indent\r$indent$oelem\r"
  82.     set prevLineEmpty 1
  83.     
  84.     foreach ln [split [string trimright [string trimleft [getSelect] "\r"]] "\r"] {
  85.         regexp {[ \t]*} $ln lntest
  86.         # Only add <P> if previous line was not empty.
  87.         if {$ln == $lntest && !$prevLineEmpty} {
  88.             set prevLineEmpty 1
  89.             if {$pIsContainer} {
  90.                 append text "$indent[htmlCloseElem P]\r$indent\r$indent$oelem\r"
  91.             } else {
  92.                 append text "\r$indent$oelem\r"
  93.             }
  94.         } else {
  95.             # Skip an empty line which follows another empty line.
  96.             if {$ln != $lntest} {
  97.                 set prevLineEmpty 0
  98.                 append text "$pind[string trim $ln]\r"
  99.             }
  100.         }
  101.     }
  102.     if {$pIsContainer} {
  103.         append text "$indent[htmlCloseElem P][htmlCloseCR2 $indent [selEnd]]"
  104.     }
  105.     
  106.     replaceText [getPos] [selEnd] $text
  107. }
  108.  
  109.  
  110. # Ask for input how to build a list. Returns "number of items" and
  111. # "ask for list item attributes". Returns "" if canceled or any problem.
  112. proc htmlListQuestions {ltype liattr lipr} {
  113.     global HTMLmodeVars
  114.     
  115.     set promptNoisily $HTMLmodeVars(promptNoisily)
  116.     if {[string length $liattr]} {
  117.         set usedatts [htmlGetUsed $liattr]
  118.     } else {
  119.         set usedatts [htmlGetUsed LI]
  120.     }
  121.     if {$lipr != "LI"} { 
  122.         set usedatts [concat $usedatts [htmlGetUsed DD]]
  123.     }
  124.     if {$HTMLmodeVars(useBigWindows)} {
  125.         set it {0 0 3 0}
  126.         while {1} {
  127.             set txt "dialog -w 280 -h 130 -b OK 20 100 85 120 -b Cancel 110 100 175 120 \
  128.             -t {$ltype list} 100 10 250 30 \
  129.             -t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
  130.             if {[llength $usedatts]} {
  131.                 append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] \
  132.                 10 70 330 85"
  133.             }
  134.             set it [eval $txt]
  135.             if {[lindex $it 1]} {return}
  136.             set items [lindex $it 2]
  137.             if {[llength $it] == 4 && [lindex $it 3]} {
  138.                 set askForLiAttr 1
  139.             } else {
  140.                 set askForLiAttr 0
  141.             }
  142.             
  143.             if {![is::UnsignedInteger $items] && $ltype != "DL"} {
  144.                 alertnote "Invalid input: non-negative integer required"
  145.             } elseif {![is::PositiveInteger $items] && $ltype == "DL"} {
  146.                 alertnote "Invalid input: positive integer required"
  147.             } else {
  148.                 break
  149.             }
  150.         }
  151.     } else {
  152.         if {$promptNoisily} {beep}    
  153.         while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
  154.             if {$items == "Cancel all!"} {message "Cancel"; return}
  155.         }
  156.         if {![is::UnsignedInteger $items] && $ltype != "DL"} {
  157.             beep; message "Invalid input: non-negative integer required."; return
  158.         } elseif {![is::PositiveInteger $items] && $ltype == "DL"} {
  159.             beep; message "Invalid input: positive integer required."; return
  160.         }
  161.         if {[llength $usedatts] && $items} {
  162.             if {$promptNoisily} {beep}    
  163.             while {[catch {statusPrompt "Ask for attributes for each $lipr? \[n\] " \
  164.             htmlStatusAskYesOrNo} v]} {
  165.                 if {$v == "Cancel all!"} {message "Cancel"; return}
  166.             }
  167.             if {$v == "yes"} {
  168.                 set askForLiAttr 1
  169.             } else {
  170.                 set askForLiAttr 0
  171.             }
  172.         } else {
  173.             set askForLiAttr 0
  174.         }
  175.     }
  176.     return [list $items $askForLiAttr]
  177. }
  178.     
  179.  
  180. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  181. # insertion point there.  If anything is selected, makes it the first item.
  182. proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
  183.     global HTMLmodeVars 
  184.     global htmlCurSel
  185.     global htmlIsSel elecStopMarker
  186.     # Discursive list?
  187.     if {$ltype == "DL"} {htmlDiscursive; return}
  188.     
  189.     set useTabMarks $HTMLmodeVars(useTabMarks)
  190.     set containers $HTMLmodeVars(lidtAreContainers)
  191.     
  192.     set listStr [htmlListQuestions $ltype $liattr LI]
  193.     if {![llength $listStr]} {
  194.         return
  195.     } else {
  196.         set items [lindex $listStr 0]
  197.         set askForLiAttr [lindex $listStr 1]
  198.     }
  199.  
  200.     # If zero list items, just make an htmlBuildCR2Elem
  201.     if {$items == 0} {
  202.         htmlBuildCR2Elem $ltype $listattr
  203.         return
  204.     }
  205.     
  206.     htmlGetSel
  207.     set sel $htmlCurSel
  208.     set indent [htmlFindNextIndent]
  209.     set exind $indent
  210.     if {$HTMLmodeVars(indent${ltype})} {
  211.         set exind [htmlIncreaseIndent $exind]
  212.         htmlIndentChunk sel
  213.     }
  214.     set IsSel $htmlIsSel
  215.     set text [htmlOpenCR $indent 1]
  216.     if {$containers} {
  217.         if {[set text1 "[htmlOpenElem $ltype $listattr 0]\r"] == "\r"} {return}
  218.         append text $text1
  219.         if {$askForLiAttr} {
  220.             set text1 [htmlOpenElem LI $liattr 0]
  221.         } else {
  222.             set text1 [htmlSetCase <LI>]
  223.         }
  224.         if {$text1 == ""} {return}
  225.         append text $exind $text1
  226.         if {$IsSel} {    
  227.             append text "${sel}[htmlCloseElem LI]"
  228.             set currpos [expr [getPos] + [string length $text]]
  229.         } else {
  230.             set currpos [expr [getPos] + [string length $text]]
  231.             append text [htmlCloseElem LI]
  232.         }
  233.         for {set i 1} {$i < $items} {incr i} {
  234.             append text "\r"
  235.             if {$askForLiAttr} {
  236.                 set text1 [htmlOpenElem LI $liattr 0]
  237.             } else {
  238.                 set text1 [htmlSetCase <LI>]
  239.             }
  240.             if {$text1 == ""} {return}
  241.             append text $exind $text1
  242.             if {$i == 1 && $IsSel} {
  243.                 set currpos [expr [getPos] + [string length $text]]
  244.             } elseif {$useTabMarks} {
  245.                 append text $elecStopMarker
  246.             }
  247.             append text [htmlCloseElem LI]
  248.         }
  249.     } else {
  250.         if {[set text1 [htmlOpenElem $ltype $listattr 0]] == ""} {return}
  251.         append text $text1
  252.         append text "\r"
  253.         if {$askForLiAttr} {
  254.             set text1 [htmlOpenElem LI $liattr 0]
  255.         } else {
  256.             set text1 [htmlSetCase <LI>]
  257.         }
  258.         if {$text1 == ""} {return}
  259.         append text $exind $text1
  260.         if {$IsSel} {        
  261.             append text $sel 
  262.         } 
  263.         set currpos [expr [getPos] + [string length $text]]
  264.         for {set i 1} {$i < $items} {incr i} {
  265.             append text "\r"
  266.             if {$askForLiAttr} {
  267.                 set text1 [htmlOpenElem LI $liattr 0]
  268.             } else {
  269.                 set text1 [htmlSetCase <LI>]
  270.             }
  271.             if {$text1 == ""} {return}
  272.             append text $exind $text1
  273.             if {$useTabMarks} {append text $elecStopMarker}
  274.         }
  275.     }
  276.     append text "\r$indent[htmlCloseElem $ltype]"
  277.     append text [htmlCloseCR2 $indent [getPos]]
  278.     if {$useTabMarks} {append text $elecStopMarker}
  279.     if {$IsSel} { deleteSelection }
  280.     
  281.     insertText $text
  282.     goto $currpos
  283. }
  284.  
  285.  
  286. # Add list entry.  If there is a selection, make it the entry.
  287.  
  288. proc htmlBuildListEntry {liattr} {
  289.     global htmlCurSel htmlIsSel HTMLmodeVars elecStopMarker
  290.     
  291.     set containers $HTMLmodeVars(lidtAreContainers)
  292.     set useTabMarks $HTMLmodeVars(useTabMarks)
  293.     htmlGetSel
  294.     set sel $htmlCurSel
  295.     set isSel $htmlIsSel
  296.     set indent [htmlFindNextIndent]
  297.     set text [htmlOpenCR $indent]
  298.     if {[set text1 [htmlOpenElem LI $liattr 0]] == ""} {return}
  299.     append text $text1
  300.     if {$isSel} { deleteSelection }
  301.     if {$containers} {
  302.         if {$isSel} { 
  303.             insertText $text "${sel}" [htmlCloseElem LI]
  304.         } else {
  305.             set currpos [expr [getPos] + [string length $text]]
  306.             append text [htmlCloseElem LI]
  307.             if {$useTabMarks} { append text $elecStopMarker}
  308.             insertText $text
  309.             goto $currpos
  310.         }
  311.     } else {
  312.         insertText $text $sel
  313.     }
  314. }
  315.  
  316. # Make list items from selection.
  317. proc htmlMakeList {} {
  318.     global HTMLmodeVars htmlHideDeprecated
  319.     
  320.     set isContainer $HTMLmodeVars(lidtAreContainers)
  321.     
  322.     if {![isSelection]} {
  323.         beep
  324.         message "No selection."
  325.         return
  326.     }
  327.     if {$htmlHideDeprecated || $HTMLmodeVars(hideDeprecated)} {
  328.         set men {UL UL OL None}
  329.     } else {
  330.         set men {UL UL OL DIR MENU None}
  331.     }
  332.  
  333.     set values [dialog -w 220 -h 130 -t "Make list" 50 10 210 30 \
  334.     -t "Each item begins with:" 10 40 160 55 -e "*" 170 40 200 55 \
  335.     -t "List:" 10 65 50 85 -m $men 55 65 200 85 \
  336.     -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  337.     
  338.     if {[lindex $values 3]} {return}
  339.     set itemStr [string trim [lindex $values 0]]
  340.     set listtype [lindex $values 1]
  341.     
  342.     if {![string length $itemStr]} {
  343.         beep
  344.         message "You must give a string which each item begins with."
  345.         return
  346.     }
  347.     set startPos [getPos]
  348.     set endPos [selEnd]
  349.     if {[catch {search -s -f 1 -i 0 -r 0 -m 0 -- $itemStr $startPos} res] || \
  350.     [lindex $res 1] > $endPos} {
  351.         beep 
  352.         message "No list item in selection."
  353.         return
  354.     }
  355.     # Check that the selections begins with a list item.
  356.     set preText [getText $startPos [lindex $res 0]]
  357.     if {![is::Whitespace $preText]} {
  358.         beep
  359.         message "There is some text before the first list item."
  360.         return
  361.     }
  362.     set indent [htmlFindNextIndent]
  363.     set liIndent $indent
  364.     if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {set liIndent [htmlIncreaseIndent $liIndent]}
  365.     if {$listtype != "None"} {
  366.         set text "[htmlOpenCR $indent 1]"
  367.         if {[string index $text 0] == "\r"} {set text "${liIndent}$text"}
  368.         append text "<[htmlSetCase $listtype]>\r"
  369.     } else {
  370.         set text ""
  371.         set preInd [htmlOpenCR $indent]
  372.         if {[regexp "\r" $preInd]} {set text $preInd}
  373.     }
  374.     # Get each list item.
  375.     set startPos [lindex $res 1]
  376.     while {![catch {search -s -f 1 -i 0 -r 0 -m 0 -- $itemStr $startPos} res2] && \
  377.     [lindex $res2 1] <= $endPos} {
  378.         set text2 [string trim [getText $startPos [lindex $res2 0]]]
  379.         if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {htmlIndentChunk text2}
  380.         append text "$liIndent<[htmlSetCase LI]>$text2"
  381.         if {$isContainer} {append text [htmlCloseElem LI]}
  382.         append text "\r"
  383.         set startPos [lindex $res2 1]
  384.     }
  385.     set text2 [string trim [getText $startPos $endPos]]
  386.     if {$listtype != "None" && $HTMLmodeVars(indent${listtype})} {htmlIndentChunk text2}
  387.     append text "$liIndent<[htmlSetCase LI]>$text2"
  388.     if {$isContainer} {append text [htmlCloseElem LI]}
  389.     append text "\r"
  390.     if {$listtype != "None"} {append text $indent [htmlCloseElem $listtype] [htmlCloseCR2 $indent [selEnd]]}
  391.     replaceText [getPos] [selEnd] $text
  392. }
  393.  
  394.  
  395. # Discursive Lists (term and description elems)
  396. #
  397. # The selection becomes the *description* (*not* the term)
  398.  
  399. # Build a discursive list
  400. proc htmlDiscursive {} {
  401.     global htmlCurSel
  402.     global htmlIsSel
  403.     global HTMLmodeVars elecStopMarker
  404.     
  405.     set containers $HTMLmodeVars(lidtAreContainers)
  406.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  407.     
  408.     set listStr [htmlListQuestions DL DT "DT and DD"]
  409.     if {![llength $listStr]} {
  410.         return
  411.     } else {
  412.         set dlEntries [lindex $listStr 0]
  413.         set askForLiAttr [lindex $listStr 1]
  414.     }
  415.     if {$askForLiAttr} {
  416.         set openDD {htmlOpenElem DD "" 0}
  417.         set openDT {htmlOpenElem DT "" 0}
  418.     } else {
  419.         set openDD {htmlSetCase <DD>}
  420.         set openDT {htmlSetCase <DT>}
  421.     }
  422.     
  423.     htmlGetSel
  424.     set Sel $htmlCurSel
  425.     set indent [htmlFindNextIndent]
  426.     set exind $indent
  427.     set text [htmlOpenCR $indent 1]
  428.     if {$HTMLmodeVars(indentDL)} {
  429.         set exind [htmlIncreaseIndent $exind]
  430.         htmlIndentChunk Sel
  431.     }
  432.     
  433.     if {$containers} {
  434.         if {[set text1 "[htmlOpenElem DL "" 0]\r"] == "\r"} {return}
  435.         append text $text1
  436.         # the first entry
  437.         if {[set text1 [eval $openDT]] == ""} {return}
  438.         append text $exind $text1
  439.         set currpos [expr [getPos] + [string length $text]]
  440.         append text "[htmlCloseElem DT]\t"
  441.         if {[set text1 [eval $openDD]] == ""} {return}
  442.         append text $text1
  443.         if {$htmlIsSel} {
  444.             append text $Sel
  445.         } elseif {$useTabMarks} {
  446.             append text $elecStopMarker
  447.         }
  448.         append text [htmlCloseElem DD]
  449.         # the rest of the entries
  450.         for {set i 1} {$i < $dlEntries} {incr i} {
  451.             append text "\r"
  452.             if {[set text1 [eval $openDT]] == ""} {return}
  453.             append text $exind $text1
  454.             if {$useTabMarks} { append text $elecStopMarker }
  455.             append text [htmlCloseElem DT] "\t"
  456.             if {[set text1 [eval $openDD]] == ""} {return}
  457.             append text $text1
  458.             if {$useTabMarks} { append text $elecStopMarker }
  459.             append text [htmlCloseElem DD] 
  460.         }
  461.         
  462.         if {$useTabMarks} {append text $elecStopMarker}
  463.         
  464.     } else {
  465.         if {[set text1 [htmlOpenElem DL "" 0]] == ""} {return}
  466.         append text $text1
  467.         append text "\r"
  468.  
  469.         # The first entry
  470.         if {[set text1 [eval $openDT]] == ""} {return}
  471.         append text $exind $text1
  472.     
  473.         set currpos [expr [getPos] + [string length $text]]
  474.         append text "\t"
  475.         if {[set text1 [eval $openDD]] == ""} {return}
  476.         append text $text1
  477.     
  478.         if {$htmlIsSel} {
  479.             append text $Sel
  480.         }
  481.         if {$useTabMarks} {append text $elecStopMarker}        
  482.     
  483.         # Now for the rest of the entries
  484.         for {set i 1} {$i < $dlEntries} {incr i} {
  485.             append text "\r"
  486.             if {[set text1 [eval $openDT]] == ""} {return}
  487.             append text $exind $text1
  488.             
  489.             if {$useTabMarks} {append text $elecStopMarker}
  490.             append text "\t"
  491.             if {[set text1 [eval $openDD]] == ""} {return}
  492.             append text $text1
  493.         
  494.             if {$useTabMarks} {append text $elecStopMarker}
  495.         }
  496.     }
  497.     append text "\r$indent[htmlCloseElem DL]"
  498.     append text [htmlCloseCR2 $indent [getPos]]
  499.     if {$useTabMarks} {append text $elecStopMarker}
  500.     if {$htmlIsSel} { deleteSelection }
  501.     insertText $text
  502.     goto $currpos
  503. }
  504.  
  505. # Add an individual entry to a discursive list
  506. proc htmlNewDiscursiveEntry {} {
  507.     global htmlCurSel htmlIsSel
  508.     global HTMLmodeVars elecStopMarker
  509.     # Is in STYLE container?
  510.     if {[htmlIsInContainer STYLE]} {replaceText [getPos] [selEnd] DT; return}
  511.  
  512.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  513.     set containers $HTMLmodeVars(lidtAreContainers)
  514.     
  515.     htmlGetSel
  516.     set Sel $htmlCurSel
  517.     set indent [htmlFindNextIndent]
  518.     set text [htmlOpenCR $indent]
  519.     if {$HTMLmodeVars(indentDL)} {
  520.         htmlIndentChunk Sel
  521.     }
  522.  
  523.     if {$containers} {
  524.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  525.         append text $text1
  526.         set currpos [expr [getPos] + [string length $text]]
  527.         append text "[htmlCloseElem DT]\t"
  528.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  529.         append text $text1
  530.         if {$htmlIsSel} {
  531.             append text ${Sel}
  532.         } elseif {$useTabMarks} {append text $elecStopMarker}
  533.         append text [htmlCloseElem DD]
  534.         if {$useTabMarks} {append text $elecStopMarker}
  535.         if {$htmlIsSel} { deleteSelection }
  536.         insertText $text [htmlCloseCR $indent]
  537.     } else {
  538.         if {[set text1 [htmlOpenElem DT "" 0]] == ""} {return}
  539.         append text $text1
  540.         set currpos [expr [getPos] + [string length $text]]
  541.         append text "\t"
  542.         if {[set text1 [htmlOpenElem DD "" 0]] == ""} {return}
  543.         append text $text1
  544.     
  545.         if {$htmlIsSel} {
  546.             append text $Sel
  547.         }
  548.         if {$useTabMarks} {append text $elecStopMarker}
  549.         if {$htmlIsSel} { deleteSelection }
  550.         insertText $text [htmlCloseCR $indent]
  551.     }
  552.     goto $currpos
  553. }
  554.  
  555.  
  556. # Different Input fields
  557.  
  558. proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
  559.     global htmlElemKeyBinding
  560.     set inp2 $inputelem
  561.     if {![info exists htmlElemKeyBinding($inputelem)]} {set inp2 "INPUT TYPE=$inputelem"}
  562.     htmlBuildOpening "INPUT TYPE=\"${inputelem}\"" $cr1 $cr2 $inp2
  563. }
  564.  
  565.  
  566. # Table template. If there is any selection it is put in the first cell.
  567. proc htmlTableTemplate {} {
  568.     global htmlCurSel htmlIsSel HTMLmodeVars elecStopMarker
  569.     
  570.     set useTabMarks $HTMLmodeVars(useTabMarks)
  571.     
  572.     set values {"" "" 0 0 0}
  573.     set rows ""
  574.     set cols ""
  575.     set tableOpen "<[htmlSetCase TABLE]>"
  576.     set trOpen "<[htmlSetCase TR]>"
  577.     while {1} {
  578.         
  579.         set box "-t {Table template} 50 10 200 25 \
  580.         -p 50 26 150 27 \
  581.         -t {Number of rows} 10 40 150 55  -e [list [lindex $values 0]] 160 40 180 55 \
  582.         -t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 \
  583.         -c {Table headers in first row} [lindex $values 2] 10 90 250 112 \
  584.         -c {Table headers in first column} [lindex $values 3] 10 112 250 134 \
  585.         -c {Don't insert TABLE tags} [lindex $values 4] 10 134 250 156 \
  586.         -b OK 20 250 85 270 -b Cancel 105 250 170 270\
  587.         -b {TABLE attributes…} 10 170 150 190 -b {TR attributes…} 10 200 150 220 "
  588.         
  589.         set values [eval [concat dialog -w 230 -h 280 $box]]
  590.         
  591.         # Cancel?
  592.         if {[lindex $values 6] } {return}
  593.         
  594.         set rows [lindex $values 0]
  595.         set cols [lindex $values 1]
  596.         set THrow [lindex $values 2]
  597.         set THcol [lindex $values 3]
  598.         set table [expr ![lindex $values 4]]
  599.         if {[lindex $values 7]} {
  600.             if {!$table} {
  601.                 alertnote "You have chosen not to insert TABLE tags."
  602.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  603.                 set tableOpen $tmp
  604.             }
  605.             continue
  606.         }
  607.         if {[lindex $values 8]} {
  608.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  609.                 set trOpen $tmp
  610.             }
  611.             continue
  612.         }
  613.         
  614.         
  615.         if {![is::PositiveInteger $rows] || ![is::PositiveInteger $cols] } {
  616.             alertnote "The number of rows and columns must be specified."
  617.         } else {
  618.             break
  619.         }
  620.     }
  621.     
  622.     htmlGetSel
  623.     if {$htmlIsSel} {deleteSelection}
  624.     set indent [htmlFindNextIndent]
  625.     set trIndent $indent
  626.     if {$HTMLmodeVars(indentTABLE) && $table} {set trIndent [htmlIncreaseIndent $trIndent]}
  627.     set tdIndent $trIndent
  628.     if {$HTMLmodeVars(indentTR)} {set tdIndent [htmlIncreaseIndent $tdIndent]}
  629.     set text [htmlOpenCR $indent 1]
  630.     if {$table} {append text "\r" $indent $tableOpen "\r$trIndent"}
  631.     
  632.     for {set i 1} {$i <= $rows} {incr i} {
  633.         if {$i > 1 || $table} {append text "\r$trIndent"}
  634.         append text "$trOpen\r$tdIndent"
  635.         for {set j 1} {$j <= $cols} {incr j} {
  636.             # Put TH in first row or column?
  637.             if {$i == 1 && $THrow || $j == 1 && $THcol} {
  638.                 set cell [htmlSetCase TH]
  639.             } else {
  640.                 set cell [htmlSetCase TD]
  641.             }
  642.             append text "<$cell>"
  643.             if {$i == 1 && $j == 1} {
  644.                 if {$htmlIsSel} {
  645.                     append text $htmlCurSel
  646.                 } else {
  647.                     set curPos [expr [getPos] + [string length $text]]
  648.                 }
  649.             } elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
  650.                 set curPos [expr [getPos] + [string length $text]]
  651.             } elseif {$useTabMarks} {
  652.                 append text $elecStopMarker
  653.             }    
  654.             append text [htmlCloseElem $cell]
  655.         }
  656.         append text "\r$trIndent[htmlCloseElem TR]\r$trIndent"
  657.     }
  658.     if {$table} {append text "\r$indent[htmlCloseElem TABLE][htmlCloseCR2 $indent [getPos]]"}
  659.     if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text $elecStopMarker}
  660.     insertText $text
  661.     goto $curPos
  662. }
  663.  
  664.  
  665. # Take table rows in a selection and remove the TR, TD and TH elements and
  666. # put tabs between the elements.
  667. proc htmlRowstoTabs {} {
  668.     if {![isSelection]} {
  669.         beep
  670.         message "No selection."
  671.         return
  672.     }
  673.     
  674.     set startPos [getPos]
  675.     set endPos [selEnd]
  676.     if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res] || \
  677.     [lindex $res 1] > $endPos} {
  678.         beep 
  679.         message "No table row in selection."
  680.         return
  681.     }
  682.     # Check that the selections begins with a table row.
  683.     set preText [getText $startPos [lindex $res 0]]
  684.     if {![is::Whitespace $preText]} {
  685.         beep
  686.         message "First part of selection is not in a table row."
  687.         return
  688.     }
  689.     # Extract each table row.
  690.     set startPos [lindex $res 1]
  691.     while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ \t\r]+[^>]*>|>)} $startPos} res2] && \
  692.     [lindex $res2 1] <= $endPos} {
  693.         set text2 [getText $startPos [lindex $res2 0]]
  694.         regsub -all "\[\t\r\]+" $text2 " " text2
  695.         append text [string trim $text2] "\r"
  696.         set startPos [lindex $res2 1]
  697.     }
  698.     set text2 [getText $startPos $endPos]
  699.     regsub -all "\[\t\r\]+" $text2 " " text2
  700.     append text [string trim $text2]
  701.     
  702.     # Check that there is nothing after the last table row.
  703.     if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] \
  704.     && [lindex $res 1] <= $endPos} {
  705.         set preText [getText [lindex $res 1] $endPos]
  706.         if {![is::Whitespace $preText]} {
  707.             beep
  708.             message "Last part of selection not in a table row."
  709.             return
  710.         }
  711.     }
  712.     # Make the transformation.
  713.     foreach ln [split $text "\r"] {
  714.         if {![string length $ln]} continue
  715.         regsub -all {> +<} $ln "><" ln
  716.         regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "\t" ln
  717.         regsub {    } $ln "" ln
  718.         regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
  719.         append out "$ln\r"
  720.     }
  721.     replaceText [getPos] [selEnd] $out
  722. }
  723.  
  724. # Convert tab-delimited format to table rows.
  725. # First row and first coloumn can optionally consist of table headers.
  726. proc htmlImportTable {} {htmlTabstoRows file}
  727.  
  728. proc htmlTabstoRows {{where selection}} {
  729.     global HTMLmodeVars
  730.     
  731.     if {$where == "selection"} {
  732.         if {![isSelection]} {
  733.             beep
  734.             message "No selection."
  735.             return
  736.         }
  737.         set tabtext [string trim [getSelect]]
  738.         set newln "\r"
  739.         set htext "Tabs to Rows"
  740.     } else {
  741.         set fil [getfile "Select file with table."]
  742.         if {![htmlIsTextFile $fil alertnote]} {return}
  743.         set fid [open $fil r]
  744.         set tabtext [string trim [read $fid]]
  745.         close $fid
  746.         if {[regexp {\n} $tabtext]} {
  747.             set newln "\n"
  748.         } else {
  749.             set newln "\r"
  750.         }
  751.         regsub -all "\n\r" $tabtext "\n" tabtext
  752.         set htext "Import table"
  753.     }
  754.     set values {0 0 0 0}
  755.     set tableOpen "<[htmlSetCase TABLE]>"
  756.     set trOpen "<[htmlSetCase TR]>"
  757.     while {1} {
  758.         
  759.         set box "-t [list $htext] 50 10 200 25 \
  760.         -p 50 26 150 27 \
  761.         -c {Table headers in first row} [lindex $values 0] 10 40 250 62 \
  762.         -c {Table headers in first column} [lindex $values 1] 10 62 250 84 \
  763.         -c {Don't insert TABLE tags} [lindex $values 2] 10 84 250 106 \
  764.         -c {Treat multiple tabs as one} [lindex $values 3] 10 106 250 128 \
  765.         -b OK 20 220 85 240 -b Cancel 105 220 170 240\
  766.         -b {TABLE attributes…} 10 140 150 160 -b {TR attributes…} 10 170 150 190 "
  767.         
  768.         set values [eval [concat dialog -w 230 -h 250 $box]]
  769.         
  770.         # Cancel?
  771.         if {[lindex $values 5] } {return}
  772.         
  773.         set THrow [lindex $values 0]
  774.         set THcol [lindex $values 1]
  775.         set table [expr ![lindex $values 2]]
  776.         if {[lindex $values 3]} {
  777.             set tabexp "\t+"
  778.         } else {
  779.             set tabexp \t
  780.         }
  781.         if {[lindex $values 6]} {
  782.             if {!$table} {
  783.                 alertnote "You have chosen not to insert TABLE tags."
  784.             } elseif {[set tmp [htmlChangeElement [string range $tableOpen 1 [expr [string length $tableOpen] - 2]] TABLE]] != ""} {
  785.                 set tableOpen $tmp
  786.             }
  787.             continue
  788.         }
  789.         if {[lindex $values 7]} {
  790.             if {[set tmp [htmlChangeElement [string range $trOpen 1 [expr [string length $trOpen] - 2]] TR]] != ""} {
  791.                 set trOpen $tmp
  792.             }
  793.             continue
  794.         }
  795.         break
  796.     }
  797.             
  798.     set oelem "${trOpen}\r"
  799.     if {$oelem == "\r"} {return}
  800.     
  801.     set trIndent ""
  802.     if {$HTMLmodeVars(indentTABLE) && $table} {set trIndent [htmlIncreaseIndent $trIndent]}
  803.     set tdIndent $trIndent
  804.     if {$HTMLmodeVars(indentTR)} {set tdIndent [htmlIncreaseIndent $tdIndent]}
  805.     
  806.     set out [htmlOpenCR "" 1]
  807.     if {$table} {append out "\r" $tableOpen "\r"}
  808.  
  809.     set i 1
  810.     foreach ln [split $tabtext $newln] {
  811.         if {![string length $ln]} {
  812.             append out "$trIndent$oelem$trIndent[htmlCloseElem TR]\r"
  813.         } else {
  814.             # Should there be headers in the first row?
  815.             if {$i == 1 && $THrow} {
  816.                 set cell TH
  817.             } else {
  818.                 set cell TD
  819.             }
  820.             # Should there be headers in the first column?
  821.             if {$THcol || ($i == 1 && $THrow)} {
  822.                 set fcell TH
  823.             } else {
  824.                 set fcell TD
  825.             }
  826.             regsub -all $tabexp $ln [htmlSetCase "</$cell><$cell>"] ln
  827.             if {$THcol} {
  828.                 regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
  829.             }
  830.             if {$i > 1 || $table} {append out "$trIndent\r"}
  831.             append out "$trIndent$oelem$tdIndent<[htmlSetCase $fcell]>$ln"
  832.             # Add cell or fcell closing, depending on if there is more than one cell.
  833.             if {![regexp [htmlCloseElem $fcell] $ln]} {
  834.                 append out [htmlCloseElem $fcell]
  835.             } else {
  836.                 append out [htmlCloseElem $cell]
  837.             }
  838.             append out "\r$trIndent[htmlCloseElem TR]\r"
  839.         }
  840.         incr i
  841.     }
  842.     set indent [htmlFindNextIndent]
  843.     if {$table} {
  844.         append out "$trIndent\r[htmlCloseElem TABLE]"
  845.         append out [htmlCloseCR2 "" [selEnd]]
  846.     }
  847.     if {$indent != ""} {htmlIndentChunk out $indent}
  848.     set out $indent[string trimright $out " \t"]
  849.     if {$where == "selection"} {
  850.         replaceText [getPos] [selEnd] $out
  851.     } else {
  852.         insertText $out
  853.     }
  854. }
  855.  
  856.  
  857. # Converts an NCSA or CERN image map file to a client side image map.
  858. proc htmlConvertNCSAMap {} {htmlConvertMap NCSA}
  859. proc htmlConvertCERNMap {} {htmlConvertMap CERN}
  860.  
  861. proc htmlConvertMap {type} {
  862.     global HTMLmodeVars
  863.     
  864.     if {[catch {getfile "Select the $type image map file."} fil] || ![htmlIsTextFile $fil alertnote] ||
  865.     [catch {open $fil r} fid]} {return}
  866.     set filecont [read $fid]
  867.     close $fid
  868.     if {[regexp {\n} $filecont]} {
  869.         set newln "\n"
  870.     } else {
  871.         set newln "\r"
  872.     }
  873.     set area [html${type}map [split $filecont $newln]]
  874.     set text [lindex $area 2]
  875.     if {![string length $text]} {
  876.         alertnote "No image map found in [file tail $fil]."
  877.         return
  878.     } elseif {[lindex $area 1]} {
  879.         if {[askyesno "Some lines in [file tail $fil] have invalid syntax. They are ignored. Continue?"] == "no"} {return}
  880.     } elseif {[lindex $area 0]} {
  881.         if {[askyesno "Some lines in [file tail $fil] specify a shape not supported. They are ignored. Continue?"] == "no"} {return}
  882.     }
  883.     if {![string length [set map [htmlOpenElem MAP "" 0]]]} {return}
  884.     set aind [set indent [htmlFindNextIndent]]
  885.     if {$HTMLmodeVars(indentMAP)} {set aind [htmlIncreaseIndent $aind]}
  886.     regsub -all "\r" [string trimright $text] "\r$aind" text
  887.     insertText [htmlOpenCR $indent 1] $map "\r" $aind $text \r $indent [htmlCloseElem MAP] [htmlCloseCR2 $indent [getPos]]
  888. }
  889.  
  890. proc htmlNCSAmap {lines} {
  891.     set notknown 0
  892.     set someinvalid 0
  893.     set area ""
  894.     set defarea ""
  895.     foreach l $lines {
  896.         set invalid 0
  897.         set l [string trim $l]
  898.         # Skip comments and blank lines
  899.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  900.         set shape [string toupper [lindex $l 0]]
  901.         if {[lsearch {RECT CIRCLE POLY DEFAULT} $shape] < 0} {
  902.             set notknown 1
  903.             continue
  904.         }
  905.         set url [lindex $l 1]
  906.         set exp "^\[0-9\]+,\[0-9\]+$"
  907.         if {[regexp $exp $url]} {
  908.             set url ""
  909.             set cind 1
  910.         } else {
  911.             set cind 2
  912.         }
  913.         switch $shape {
  914.             RECT {
  915.                 if {[regexp $exp [lindex $l $cind]] && [regexp $exp [lindex $l [expr $cind + 1]]]} {
  916.                     set coord "[lindex $l $cind],[lindex $l [expr $cind + 1]]"
  917.                 } else {
  918.                     set invalid 1
  919.                 }
  920.             }
  921.             CIRCLE {
  922.                 if {[regexp $exp [lindex $l $cind] cent] && [regexp $exp [lindex $l [expr $cind + 1]] edge]} {
  923.                     regexp {[0-9]+} $cent xc
  924.                     regexp {[0-9]+} $edge xe
  925.                     set coord "$cent,[expr $xe-$xc]"
  926.                 } else {
  927.                     set invalid 1
  928.                 }
  929.             }
  930.             POLY {
  931.                 set coord ""
  932.                 foreach c [lrange $l $cind end] {
  933.                     if {![regexp $exp $c]} {
  934.                         set invalid 1
  935.                         break
  936.                     }
  937.                     append coord "$c,"
  938.                 }
  939.                 set coord [string trimright $coord ,]
  940.             }
  941.         }
  942.         if {!$invalid} {
  943.             if {$shape == "DEFAULT"} {
  944.                 set toapp defarea
  945.             } else {
  946.                 set toapp area
  947.             }
  948.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  949.             if {$shape != "DEFAULT"} {
  950.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  951.             }
  952.             if {[string length $url]} {
  953.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  954.             } else {
  955.                 append $toapp " [htmlSetCase NOHREF]"
  956.             }
  957.             append $toapp ">\r"
  958.         } else {
  959.             set someinvalid 1
  960.         }
  961.     }
  962.     append area $defarea
  963.     return [list $notknown $someinvalid $area] 
  964. }
  965.  
  966. proc htmlCERNmap {lines} {
  967.     set notknown 0
  968.     set someinvalid 0
  969.     set area ""
  970.     set defarea ""
  971.     foreach l $lines {
  972.         set invalid 0
  973.         set l [string trim $l]
  974.         # Skip comments and blank lines
  975.         if {[regexp {^#} $l] || ![string length $l]} {continue}
  976.         set shape [string toupper [lindex $l 0]]
  977.         if {![string match RECT* $shape] && ![string match CIRC* $shape] &&
  978.         ![string match POLY* $shape] && ![string match DEFAULT $shape]} {
  979.             set notknown 1
  980.             continue
  981.         }
  982.         set exp "^\\(\[0-9\]+,\[0-9\]+\\)$"
  983.         switch -glob $shape {
  984.             RECT* {
  985.                 set url [lindex $l 3]
  986.                 if {[regexp $exp [lindex $l 1]] && [regexp $exp [lindex $l 2]]} {
  987.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[string trimleft [string trimright [lindex $l 2] )] (]"
  988.                     set shape RECT
  989.                 } else {
  990.                     set invalid 1
  991.                 }
  992.             }
  993.             CIRC* {
  994.                 set url [lindex $l 3]
  995.                 if {[regexp $exp [lindex $l 1]] && [regexp {^[0-9]+$} [lindex $l 2]]} {
  996.                     set coord "[string trimleft [string trimright [lindex $l 1] )] (],[lindex $l 2]"
  997.                     set shape CIRCLE
  998.                 } else {
  999.                     set invalid 1
  1000.                 }
  1001.             }
  1002.             POLY* {
  1003.                 set coord ""
  1004.                 set url [lindex $l [expr [llength $l] - 1]]
  1005.                 if {[regexp $exp $url]} {
  1006.                     set url ""
  1007.                     set cind 1
  1008.                 } else {
  1009.                     set cind 2
  1010.                 }
  1011.                 foreach c [lrange $l 1 [expr [llength $l] - $cind]] {
  1012.                     if {![regexp $exp $c]} {
  1013.                         set invalid 1
  1014.                         break
  1015.                     }
  1016.                     append coord "[string trimleft [string trimright $c )] (],"
  1017.                 }
  1018.                 set coord [string trimright $coord ,]
  1019.                 set shape POLY
  1020.             }
  1021.             DEFAULT {
  1022.                 set url [lindex $l 1]
  1023.             }
  1024.         }
  1025.         if {!$invalid} {
  1026.             if {$shape == "DEFAULT"} {
  1027.                 set toapp defarea
  1028.             } else {
  1029.                 set toapp area
  1030.             }
  1031.             append $toapp "<" [htmlSetCase "AREA SHAPE=\"$shape\""]
  1032.             if {$shape != "DEFAULT"} {
  1033.                 append $toapp " [htmlSetCase COORDS]=\"$coord\""
  1034.             }
  1035.             if {[string length $url]} {
  1036.                 append $toapp " [htmlSetCase HREF]=\"$url\""
  1037.             } else {
  1038.                 append $toapp " [htmlSetCase NOHREF]"
  1039.             }
  1040.             append $toapp ">\r"
  1041.         } else {
  1042.             set someinvalid 1
  1043.         }
  1044.     }
  1045.     append area $defarea
  1046.     return [list $notknown $someinvalid $area] 
  1047. }
  1048.  
  1049. proc htmlComment {} {
  1050.     global htmlCurSel
  1051.     global htmlIsSel
  1052.     global HTMLmodeVars elecStopMarker
  1053.     set comStrs [htmlCommentStrings]
  1054.     htmlGetSel
  1055.     set text "[htmlOpenCR [set indent [htmlFindNextIndent]]][lindex $comStrs 0]$htmlCurSel"
  1056.     if {$htmlIsSel} { deleteSelection }
  1057.     set currpos [expr [getPos] + [string length $text]]
  1058.     append text [lindex $comStrs 1] [htmlCloseCR $indent]
  1059.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text $elecStopMarker}
  1060.     insertText $text
  1061.     if {!$htmlIsSel}    {
  1062.         goto $currpos
  1063.     }
  1064. }
  1065.  
  1066. proc htmlDocumentType {} {
  1067.     set v [dialog -w 200 -h 120 -t "Document type declaration" 10 10 190 30 \
  1068.       -m {Strict Strict Transitional Frameset} 10 50 190 70 -b OK 20 90 85 110 -b Cancel 105 90 170 110]
  1069.     if {[lindex $v 2]} {return}
  1070.     set pos [getPos]
  1071.     goto 0
  1072.     switch [lindex $v 0] {
  1073.         Strict {set dtd {}}
  1074.         Transitional {set dtd " Transitional"}
  1075.         Frameset {set dtd " Frameset"}
  1076.     }
  1077.     set txt "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0$dtd//EN\">\n"
  1078.     if {![catch {search -s -f 1 -i 0 -m 0 -r 1 {<!DOCTYPE[^<>]+>} 0} res]} {
  1079.         eval deleteText $res
  1080.     } else {
  1081.         set res {0 0}
  1082.     }
  1083.     insertText $txt
  1084.     goto [expr $pos + [string length $txt] - [lindex $res 1] + [lindex $res 0]]
  1085.     htmlActivateHook
  1086. }
  1087.  
  1088. #
  1089. # Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
  1090. # Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
  1091. proc htmlNewDocument {} {htmlNewTemplate BODY}
  1092. proc htmlNewDoc.withFrames {} {htmlNewTemplate FRAMESET}
  1093.  
  1094. proc htmlNewTemplate {doctype} {
  1095.     global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHideExtensions htmlHideDeprecated elecStopMarker
  1096.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1097.     set footers $HTMLmodeVars(footers)
  1098.     set indentBODY $HTMLmodeVars(indent${doctype})
  1099.     set headelems [set htmlHeadElements1]
  1100.     
  1101.     set bodyText ""
  1102.     # If the window is not empty, either new window or put text in the body.
  1103.     if {![htmlIsEmptyFile]} {
  1104.         set delBox [dialog -w 420 -h 90 -t "Nonempty window. Do you want to open a new window\
  1105.         or put the text in the document's BODY?" 10 10 410 50 \
  1106.         -b "New window" 20 60 120 80 \
  1107.         -b "Put in BODY" 140 60 240 80 -b Cancel 260 60 325 80]
  1108.         if {[lindex $delBox 0]} {
  1109.             new -n Untitled.html -m HTML
  1110.         } elseif {[lindex $delBox 2]} {
  1111.             return
  1112.         } else {
  1113.             set bodyText "[getText 0 [maxPos]]\r"
  1114.         }
  1115.     } 
  1116.     
  1117.     if {$doctype == "FRAMESET"} {
  1118.         set htxt "New document with frames"
  1119.     } else {
  1120.         set htxt "New document"
  1121.     }
  1122.     if {$indentBODY} {htmlIndentChunk bodyText}
  1123.     # Building footer menu.
  1124.     foreach f $footers {
  1125.         lappend foot [file tail $f]
  1126.     }
  1127.     set footmenu {"No footer"}
  1128.     if {[info exists foot]} {
  1129.         set footmenu [concat $footmenu [lsort $foot]]
  1130.     }
  1131.     
  1132.     set docTitle ""
  1133.     set inHead {0 0 ""}
  1134.     foreach elem $headelems {
  1135.         lappend inHead 0
  1136.     }
  1137.     lappend inHead "No footer" 0 1 0
  1138.     while {![string length $docTitle]} {
  1139.         
  1140.         # Construct the dialog box.
  1141.         set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 \
  1142.         -e [list [lindex $inHead 2]] 70 40 390 55 \
  1143.         -t {Select the elements you want in the document\'s HEAD} 10 70 390 85"
  1144.         set hpos 100
  1145.         set wpos 10
  1146.         set i 3
  1147.         foreach elem $headelems {
  1148.             append box " -c $elem [lindex $inHead $i] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]"
  1149.             incr wpos 100
  1150.             if {$wpos > 110} {set wpos 10; incr hpos 20}
  1151.             incr i
  1152.         }
  1153.         if {$wpos > 10} {incr hpos 20}
  1154.         incr hpos 10
  1155.         append box " -t Footer 10 $hpos 80 [expr $hpos + 15] \
  1156.         -m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
  1157.         incr hpos 30
  1158.         append box " -t {Document type declaration:} 220 100 405 115"
  1159.         append box " -r None [lindex $inHead [expr $i + 1]] 220 120 390 135"
  1160.         if {$doctype == "BODY"} {
  1161.             append box " -r Transitional [lindex $inHead [expr $i + 2]] 220 140 390 155"
  1162.             append box " -r Strict [lindex $inHead [expr $i + 3]] 220 160 390 175"
  1163.         } else {
  1164.             append box " -r Frameset [lindex $inHead [expr $i + 2]] 220 140 390 155"
  1165.         }
  1166.         set inHead [eval [concat dialog -w 410 -h [expr $hpos + 30] \
  1167.         -b OK 20 $hpos 85 [expr $hpos + 20] \
  1168.         -b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
  1169.         if {[lindex $inHead 1] } {
  1170.             return
  1171.         }
  1172.         set docTitle [string trim [lindex $inHead 2]]
  1173.         if {![string length $docTitle]} {
  1174.             alertnote "A document title is required."
  1175.         }
  1176.     }
  1177.     
  1178.     if {![lindex $inHead [expr $i + 1]]} {
  1179.         if {$doctype == "BODY"} {
  1180.             if {[lindex $inHead [expr $i + 2]]} {set dtd " Transitional"; set htmlHideExtensions 1}
  1181.             if {[lindex $inHead [expr $i + 3]]} {set dtd ""; set htmlHideDeprecated 1}
  1182.         } else {
  1183.             set dtd " Frameset"
  1184.         }
  1185.         htmlSetDis
  1186.         set text "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0$dtd//EN\">\n"
  1187.     }
  1188.     
  1189.     if {[set text0 [htmlOpenElem HTML "" 0]] == "" || 
  1190.     [set text1 [htmlOpenElem HEAD "" 0]] == "" ||
  1191.     [set text2 [htmlOpenElem TITLE "" 0]] == ""} {
  1192.         return
  1193.     }
  1194.     append text $text0
  1195.     set headIndent ""
  1196.     if {$HTMLmodeVars(indentHEAD)} {set headIndent [text::Tab]}
  1197.     set bodyIndent ""
  1198.     if {$indentBODY} {set bodyIndent [text::Tab]}
  1199.     append text "\r\r${text1}\r$headIndent\r"
  1200.     append text "$headIndent${text2}${docTitle}[htmlCloseElem TITLE]\r$headIndent"
  1201.     set hasScript 0
  1202.     set pre(SCRIPT) "//"; set pre(STYLE) "/*"; set post(SCRIPT) ""; set post(STYLE) "*/"
  1203.     for {set i 0} {$i < [llength  $headelems]} {incr i} {
  1204.         if {[lindex $inHead [expr $i + 3]]} {
  1205.             set he [lindex $headelems $i]
  1206.             if {[set text1 [htmlOpenElem $he "" 0]] != ""} {
  1207.                 append text "\r$headIndent${text1}"
  1208.                 if {$he == "SCRIPT" || $he == "STYLE"} {
  1209.                     append text "\r$headIndent<!-- /* Hide content from old browsers */\r$headIndent"
  1210.                     if {!$hasScript} {
  1211.                         set currpos [string length $text]
  1212.                     } elseif {$useTabMarks} {
  1213.                         append text $elecStopMarker
  1214.                     }
  1215.                     set hasScript 1
  1216.                     append text "\r$headIndent$pre($he) end hiding content from old browsers $post($he) -->\r$headIndent[htmlCloseElem $he]"
  1217.                 }
  1218.             }
  1219.         }
  1220.     }
  1221.     append text "\r$headIndent\r[htmlCloseElem HEAD]\r\r"
  1222.     
  1223.     if {[set text1 [htmlOpenElem $doctype "" 0]] == ""} {
  1224.         return
  1225.     }
  1226.     append text "$text1\r$bodyIndent\r$bodyIndent"
  1227.     append text $bodyText
  1228.     if {!$hasScript} {
  1229.         set currpos [string length $text]
  1230.     } elseif {$useTabMarks} {
  1231.         append text $elecStopMarker
  1232.     }    
  1233.     
  1234.     # Insert footer.
  1235.     set footval [lindex $inHead [expr [llength $headelems] + 3]]
  1236.     if {$footval != "No footer"} {
  1237.         set footerFile [lindex $footers [lsearch -exact $foot $footval]]
  1238.         if {![catch {readFile $footerFile} footText]} {
  1239.             if {$indentBODY} {
  1240.                 regsub -all "\n" "[text::Tab]$footText" "\r" footText
  1241.                 htmlIndentChunk footText
  1242.             }
  1243.             append text "\r$bodyIndent\r$footText"
  1244.         } else {
  1245.             alertnote "Could not read footer, $footerFile"
  1246.         }
  1247.     }
  1248.     append text "\r$bodyIndent\r[htmlCloseElem $doctype]\r\r[htmlCloseElem HTML]"
  1249.     if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
  1250.     insertText $text
  1251.  
  1252.     goto $currpos
  1253.     htmlActivateHook
  1254. }
  1255.  
  1256.  
  1257. #===============================================================================
  1258. # Document index
  1259. #===============================================================================
  1260.  
  1261. proc htmlDocumentIndex {} {
  1262.     global HTMLmodeVars
  1263.     
  1264.     set liIndent ""
  1265.     set indLists $HTMLmodeVars(indentUL)
  1266.     if {$indLists} {set liIndent [text::Tab]}
  1267.     
  1268.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#DOCINDEX[ \t\r]+[^>]+>} 0} begin] &&
  1269.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#DOCINDEX[ \t\r]+[^>]+>} [lindex $begin 1]} endind] &&
  1270.     [regexp -nocase {TYPE=\"(UL|PRE,[0-9]+)\"} [getText [lindex $begin 0] [lindex $begin 1]] dum type]} {
  1271.         set type [string toupper $type]
  1272.         if {$type != "UL"} {
  1273.             regexp {(PRE),([0-9]+)} $type dum type indent
  1274.             set indStr [string range "                                  " 1 $indent]
  1275.         }
  1276.         set replace 1
  1277.         set mainind [htmlFindNextIndent [lindex $begin 0]]
  1278.     } else {
  1279.         set replace 0
  1280.         set values {0 0 0 3}
  1281.         set mainind [htmlFindNextIndent]
  1282.         while {1} {
  1283.             set box "-t {Document index} 50 10 250 30 -m {[list [lindex $values 2]] PRE UL} 10 40 60 60\
  1284.             -n PRE -t Indent 70 40 120 60 -e [list [lindex $values 3]] 125 40 165 55 \
  1285.             -t characters 170 40 290 60"
  1286.             set values [eval [concat dialog -w 300 -h 105 -b OK 20 75 85 95 -b Cancel 110 75 175 95 $box]]
  1287.             set type [lindex $values 2]
  1288.             if {[lindex $values 1]} {return}
  1289.             if {$type == "PRE"} {
  1290.                 set indent [lindex $values 3]
  1291.                 if {[is::PositiveInteger $indent]} {
  1292.                     set indStr [string range "                                  " 1 $indent]
  1293.                     break
  1294.                 } else {
  1295.                     alertnote "The number of characters to indent must be specified."
  1296.                 }
  1297.             } else {
  1298.                 break
  1299.             }
  1300.         }
  1301.     }
  1302.  
  1303.     set pos 0
  1304.     set exp {<[Hh][1-6][^>]*>}
  1305.     set exp2 {</[Hh][1-6]>}
  1306.     set indLevel 1
  1307.     set headSize 0
  1308.     set toc "\r\r<[htmlSetCase $type]>"
  1309.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  1310.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  1311.         set start [lindex $rs 0]
  1312.         set end [lindex $res 1]
  1313.         set text [getText $start $end]
  1314.         set thisSize [getText [expr $start + 2] [expr $start + 3]]
  1315.         set text2 [getText [lindex $rs 1] [lindex $res 0]]
  1316.         regsub -all "\[\t\r\]+" $text " " text
  1317.         # remove all tags from text
  1318.         set headtext [string trim [htmlTagStrip $text]]
  1319.         # Remove " from text.
  1320.         regsub -all "\"" $headtext "" headtext
  1321.         # Check if there is already an anchor
  1322.         if {[regexp -nocase {<A[ \t\r\n]+[^<>]*NAME=(\"[^\">]+\"|[^ \t\n\r>]+)} $text2 dum anchor]} {
  1323.             set anchor [string trim $anchor \"]
  1324.         } else {
  1325.             # Insert an anchor
  1326.             set anchor [string trim [string range $headtext 0 15]]
  1327.             # Make sure a &xxx; is not chopped.
  1328.             if {[set amp [string last & $anchor]] > [set semi [string last \; $anchor]]} {
  1329.                 set rest [string range $headtext 16 end]
  1330.                 append anchor [string range $rest 0 [string first \; $rest]]
  1331.             }
  1332.             # Is there an <A> tag?
  1333.             if {[regexp -nocase -indices {<A([ \t\r\n]+[^<>]+>|>)} $text2 atag]} {
  1334.                 set text3 " [htmlSetCase NAME]=\"$anchor\""
  1335.                 replaceText [set blah [expr [lindex $rs 1] + [lindex $atag 0] + 2]] $blah $text3
  1336.                 incr end [string length $text3]
  1337.             } else {
  1338.                 set text3 "<[htmlSetCase {A NAME}]=\"$anchor\">$text2[htmlCloseElem A]"
  1339.                 replaceText [lindex $rs 1] [lindex $res 0] $text3
  1340.                 incr end [expr [string length $text3] - [string length $text2]]
  1341.             }
  1342.         }
  1343.         
  1344.         if {!$headSize} {
  1345.             # first header
  1346.             set headSize $thisSize
  1347.         } elseif {$thisSize > $headSize && $headSize} {
  1348.             # new list
  1349.             for {set i $headSize} {$i < $thisSize} {incr i} { 
  1350.                 if {$type == "UL"} {
  1351.                     append toc "\r$liIndent\r$liIndent<[htmlSetCase UL]>"
  1352.                     if {$indLists} {set liIndent [htmlIncreaseIndent $liIndent]}
  1353.                 }
  1354.             }
  1355.             incr indLevel [expr $thisSize - $headSize]
  1356.             set headSize $thisSize
  1357.         } elseif {$thisSize < $headSize && $indLevel} {
  1358.             # close a list
  1359.             for {set i $thisSize} {$i < $headSize && $indLevel > 1} {incr i} {
  1360.                 if {$type == "UL"} {
  1361.                     if {$indLists} {set liIndent [htmlReduceIndent $liIndent]}
  1362.                     append toc "\r$liIndent[htmlCloseElem UL]\r$liIndent"
  1363.                 }
  1364.                 incr indLevel -1
  1365.             }
  1366.             set headSize $thisSize
  1367.         }
  1368.         if {$type == "UL"} {
  1369.             append toc "\r$liIndent" [htmlSetCase <LI>]
  1370.         } else {
  1371.             append toc \r
  1372.             for {set i 1} {$i < $indLevel} {incr i} {
  1373.                 append toc $indStr
  1374.             }
  1375.         }
  1376.         append toc "[htmlSetCase {<A HREF}]=\"#$anchor\">$headtext[htmlCloseElem A]"
  1377.         set pos $end
  1378.     }
  1379.     if {$type == "UL"} {
  1380.         for {set i $indLevel} {$i > 0} {incr i -1} {
  1381.             if {$indLists} {set liIndent [htmlReduceIndent $liIndent]}
  1382.             append toc "\r$liIndent[htmlCloseElem UL]\r$liIndent"
  1383.         }
  1384.     } else {
  1385.         append toc "\r[htmlCloseElem PRE]\r\r"
  1386.     }
  1387.     if {$replace} {
  1388.         if {$type == "UL"} {
  1389.             if {$mainind != ""} {htmlIndentChunk toc $mainind}
  1390.         }
  1391.         if {$pos == 0} {set toc ""}
  1392.         # Find list again in case it has moved.
  1393.         set begin [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#DOCINDEX[ \t\r]+[^>]+>} 0]
  1394.         set endind [search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#DOCINDEX[ \t\r]+[^>]+>} [lindex $begin 1]]
  1395.         replaceText [lindex $begin 1] [lindex $endind 0] [string trimright $toc] \r\r $mainind
  1396.     } else {
  1397.         set tt ""
  1398.         if {$pos == 0} {alertnote "Empty index."; return}
  1399.         if {$type == "PRE"} {
  1400.             set tt ",$indent"
  1401.             set ind ""
  1402.         } else {
  1403.             if {$mainind != ""} {htmlIndentChunk toc $mainind}
  1404.         }
  1405.         insertText [htmlOpenCR $mainind 1] [htmlSetCase "<!-- #DOCINDEX TYPE=\"$type$tt\" -->"] \
  1406.             [string trimright $toc] \r\r $mainind [htmlSetCase "<!-- /#DOCINDEX -->"] [htmlCloseCR2 $mainind [getPos]]
  1407.     }
  1408. }
  1409.